﻿
Imports System.IO
Imports std
Imports xmlctrl

Public Class parser

    Public output As MemoryStream

    'each time, read a tag with attribute or just text
    Protected Enum type
        tag
        text
    End Enum

    Protected Shared ReadOnly tagleading As String = xmlcontrol.tagleading()
    Protected Shared ReadOnly tagleadinglen As Int32 = strlen(tagleading)
    Protected Shared ReadOnly tagfinal As String = xmlcontrol.tagfinal()
    Protected Shared ReadOnly tagfinallen As Int32 = strlen(tagfinal)
    Protected Shared ReadOnly endtagmark As String = xmlcontrol.endtagmark()
    Protected Shared ReadOnly endtagmarklen As Int32 = strlen(endtagmark)
    Protected Shared ReadOnly attributeSeperator As String = xmlcontrol.attributeSeperator()
    Protected Shared ReadOnly attributeSeperatorLen As Int32 = strlen(attributeSeperator)
    Protected Shared ReadOnly valueleading As String = xmlcontrol.valueleading()
    Protected Shared ReadOnly valueleadinglen As Int32 = strlen(valueleading)
    Protected Shared ReadOnly valueleading2 As String = character.singleQuotation
    Protected Shared ReadOnly valueleading2len As Int32 = strlen(valueleading2)
    Protected Shared ReadOnly valuefinal As String = xmlcontrol.valuefinal()
    Protected Shared ReadOnly valuefinallen As Int32 = strlen(valuefinal)
    Protected Shared ReadOnly valuefinal2 As String = valueleading2
    Protected Shared ReadOnly valuefinal2len As Int32 = valueleading2len
    Protected Shared ReadOnly onelinecontrolmark As String = character.questionMark
    Protected Shared ReadOnly onelinecontrolmarklen As Int32 = strlen(onelinecontrolmark)
    Protected Shared ReadOnly onelinecontrolmark2 As String = character.exclamationMark
    Protected Shared ReadOnly onelinecontrolmark2len As Int32 = strlen(onelinecontrolmark2)
    Protected Shared ReadOnly commentstartmark As String = comment.begin_tag
    Protected Shared ReadOnly commentstartmarklen As Int32 = strlen(commentstartmark)
    Protected Shared ReadOnly commentendmark As String = comment.tagfinal
    Protected Shared ReadOnly commentendmarklen As Int32 = strlen(commentendmark)
    Protected Shared ReadOnly cdatastartmark As String = CDATA.CDStart
    Protected Shared ReadOnly cdatastartmarklen As Int32 = CDATA.CDStartLen
    Protected Shared ReadOnly cdataendmark As String = CDATA.CDEnd
    Protected Shared ReadOnly cdataendmarklen As Int32 = CDATA.CDEndLen

    Protected Delegate Function isdelegate(ByVal content As String, ByVal i As Int32, ByVal len As Int32) As Boolean

    Protected Function findnext(ByVal content As String, ByRef index As Int32 _
                             , ByVal len As Int32, ByVal find As isdelegate) As Boolean
        While index < len AndAlso Not find(content, index, len)
            index += 1
        End While

        If index = len Then
            Return False
        Else
            Return True
        End If
    End Function

    Protected Function readstring(ByVal content As String, ByRef index As Int32 _
                               , ByVal len As Int32, ByRef isends As isdelegate) As String
        Dim rtn As String = Nothing
        Dim i As Int32
        i = index
        If Not findnext(content, i, len, isends) Then
            i = len
        End If
        rtn = strmid(content, index, i - index)
        index = i
        Return rtn
    End Function

    Protected Function isspacechars(ByVal content As String, ByVal index As Int32, ByVal len As Int32) As Boolean
        Return index < len AndAlso isspace(content(index))
    End Function

    Protected Function isnotspacechars(ByVal content As String, ByVal index As Int32, ByVal len As Int32) As Boolean
        Return index < len AndAlso Not isspace(content(index))
    End Function

    Protected Function isendtagmark(ByVal content As String, ByVal index As Int32, ByVal len As Int32) As Boolean
        Return (index <= len - endtagmarklen AndAlso strsame(content, index, endtagmark, 0, endtagmarklen, False))
    End Function

    Protected Function isattributeseperator(ByVal content As String, ByVal index As Int32, ByVal len As Int32) As Boolean
        Return index <= len - attributeSeperatorLen _
                AndAlso strsame(content, index, attributeSeperator, 0, attributeSeperatorLen, False)
    End Function

    Protected Function isvalueleading1(ByVal content As String, ByVal index As Int32, ByVal len As Int32) As Boolean
        Return (index <= len - valueleadinglen AndAlso strsame(content, index, valueleading, 0, valueleadinglen, False))
    End Function

    Protected Function isvalueleading2(ByVal content As String, ByVal index As Int32, ByVal len As Int32) As Boolean
        Return (index <= len - valueleading2len AndAlso strsame(content, index, valueleading2, 0, valueleading2len, False))
    End Function

    Protected Function isvalueleading(ByVal content As String, ByVal index As Int32, ByVal len As Int32) As Boolean
        Return isvalueleading1(content, index, len) _
            OrElse isvalueleading2(content, index, len)
    End Function

    Protected Function isvaluefinal1(ByVal content As String, ByVal index As Int32, ByVal len As Int32) As Boolean
        Return (index <= len - valuefinallen AndAlso strsame(content, index, valuefinal, 0, valuefinallen, False))
    End Function

    Protected Function isvaluefinal2(ByVal content As String, ByVal index As Int32, ByVal len As Int32) As Boolean
        Return (index <= len - valuefinal2len AndAlso strsame(content, index, valuefinal2, 0, valuefinal2len, False))
    End Function

    Protected Function isvaluefinal(ByVal content As String, ByVal index As Int32, ByVal len As Int32) As Boolean
        Return isvaluefinal1(content, index, len) _
            OrElse isvaluefinal2(content, index, len)
    End Function

    Protected Function isnotspacechars_valueleading(ByVal content As String _
                                              , ByVal index As Int32, ByVal len As Int32) As Boolean
        Return isnotspacechars(content, index, len) OrElse isvalueleading(content, index, len)
    End Function

    Protected Function isonelinecontrolmark(ByVal content As String, ByVal index As Int32 _
                                            , ByVal len As Int32) As Boolean
        Return (index <= len - onelinecontrolmarklen _
                AndAlso strsame(content, index, onelinecontrolmark, 0, onelinecontrolmarklen, False))
    End Function

    Protected Function isonelinecontrolmark2(ByVal content As String, ByVal index As Int32 _
                                             , ByVal len As Int32) As Boolean
        Return (index <= len - onelinecontrolmark2len _
                AndAlso strsame(content, index, onelinecontrolmark2, 0, onelinecontrolmark2len, False))
    End Function

    Protected Function isonelinecontrolmarks(ByVal content As String, ByVal index As Int32 _
                                             , ByVal len As Int32) As Boolean
        Return isonelinecontrolmark(content, index, len) _
                OrElse isonelinecontrolmark2(content, index, len)
    End Function

    Protected Function iscommentstartmark(ByVal content As String, ByVal index As Int32 _
                                     , ByVal len As Int32) As Boolean
        Return (index <= len - commentstartmarklen _
                AndAlso strsame(content, index, commentstartmark, 0, commentstartmarklen, False))
    End Function

    Protected Function iscommentendmark(ByVal content As String, ByVal index As Int32 _
                                        , ByVal len As Int32) As Boolean
        Return (index <= len - commentendmarklen _
                AndAlso strsame(content, index, commentendmark, 0, commentendmarklen, False))
    End Function

    Protected Function iscdatastartmark(ByVal content As String, ByVal index As Int32 _
                                        , ByVal len As Int32) As Boolean
        Return (index <= len - cdatastartmarklen _
                AndAlso strsame(content, index, cdatastartmark, 0, cdatastartmarklen, False))
    End Function

    Protected Function iscdataendmark(ByVal content As String, ByVal index As Int32 _
                                      , ByVal len As Int32) As Boolean
        Return (index <= len - cdataendmarklen _
                AndAlso strsame(content, index, cdataendmark, 0, cdataendmarklen, False))
    End Function

    Protected Function readvalue(ByVal content As String, ByRef index As Int32, ByVal len As Int32) As String
        Dim rtn As String = Nothing
        If Not findnext(content, index, len, AddressOf isnotspacechars_valueleading) Then
            index = len
        Else
            If isvalueleading(content, index, len) Then
                If isvalueleading1(content, index, len) Then
                    index += valueleadinglen
                    rtn = readstring(content, index, len, AddressOf isvaluefinal)
                Else
                    index += valueleading2len
                    rtn = readstring(content, index, len, AddressOf isvaluefinal)
                End If

                If isvaluefinal1(content, index, len) Then
                    index += valuefinallen
                Else
                    index += valuefinal2len
                End If
            Else
                rtn = readstring(content, index, len, AddressOf isspacechars)
            End If
        End If

        Return rtn
    End Function

    Protected Overridable Function generateControl(ByVal tag As String, ByVal onelineControl As Boolean) As xmlcontrol
        Dim rtn As xmlcontrol
        If onelineControl Then
            rtn = New onelineXmlControl(output, tag)
        Else
            rtn = New xmlcontrol(output, tag)
        End If
        Return rtn
    End Function

    Protected Overridable Function generateCDATA() As xmlcontrol
        Return New CDATA(output)
    End Function

    Protected Overridable Function generateComment() As xmlcontrol
        Return New comment(output)
    End Function

    Protected Overridable Sub insertAttribute(ByVal ctrl As xmlcontrol _
                                              , ByVal attribute As String, ByVal value As String)
        ctrl.attributes(attribute) = value
    End Sub

    Protected Function readtag(ByVal content As String, ByRef endtag As Boolean) As xmlcontrol
        'do not try to validate here
        Dim len As Int32
        len = strlen(content)
        assert(len > 0, "content length = 0")
        assert(Not isspace(content(0)), "forget to remove left blanks?")

        Dim rtn As xmlcontrol = Nothing
        If iscdatastartmark(content, 0, len) Then
            rtn = generateCDATA()
            convertor.cast(Of CDATA)(rtn).text = strmid(content, cdatastartmarklen)
            endtag = True
        ElseIf iscommentstartmark(content, 0, len) Then
            rtn = generateComment()
            convertor.cast(Of comment)(rtn).text = strmid(content, commentstartmarklen)
            endtag = True
        Else
            assert(Not isspace(content(len - 1)), "forget to remove right blanks?")
            If Not isendtagmark(content, 0, len) Then
                'this is not a tag of /xxxx, should read the content of it
                Dim oneline As Boolean
                oneline = isonelinecontrolmarks(content, 0, len)
                endtag = isendtagmark(content, len - endtagmarklen, len)
                If endtag Then
                    len -= endtagmarklen
                    cutstring(content, len)
                Else
                    endtag = oneline
                End If
                Dim index As Int32
                index = 0
                Dim tag As String = Nothing
                tag = readstring(content, index, len, AddressOf isspacechars)
                rtn = generateControl(tag, oneline)
                While index < len
                    If findnext(content, index, len, AddressOf isnotspacechars) Then
                        Dim attribute As String = Nothing
                        Dim value As String = Nothing
                        attribute = readstring(content, index, len, AddressOf isattributeseperator)
                        index += attributeSeperatorLen
                        value = readvalue(content, index, len)
                        insertAttribute(rtn, attribute, value)
                    End If
                End While
            Else
                endtag = True
            End If
        End If

        Return rtn
    End Function

    Protected Function istagfinal(ByVal content As String, ByVal index As Int32, ByVal len As Int32) As Boolean
        Return index <= len - tagfinallen AndAlso strsame(content, index, tagfinal, 0, tagfinallen, False)
    End Function

    Protected Function istagleading(ByVal content As String, ByVal index As Int32, ByVal len As Int32) As Boolean
        Return index <= len - tagleadinglen AndAlso strsame(content, index, tagleading, 0, tagleadinglen, False)
    End Function

    Protected Function read(ByVal content As String, ByRef index As Int32 _
                         , ByRef t As type, ByVal len As Int32) As String
        Dim i As Int32
        i = index
        Dim rtn As String = Nothing
        If Not findnext(content, i, len, AddressOf isnotspacechars) Then
            index = len
        Else
            If istagleading(content, i, len) Then
                t = type.tag
                If iscdatastartmark(content, i, len) Then
                    index = i
                    If Not findnext(content, i, len, AddressOf iscdataendmark) Then
                        i = len
                    End If
                    rtn = strmid(content, index, i - index)
                    index = i + cdataendmarklen
                    ' leave the start cdata mark for verify in readtag, <![CDATA[
                    ' to avoid change structure
                    ' clear the end cdata mark
                ElseIf iscommentstartmark(content, i, len) Then
                    index = i
                    If Not findnext(content, i, len, AddressOf iscommentendmark) Then
                        i = len
                    End If
                    rtn = strmid(content, index, i - index)
                    index = i + commentendmarklen
                    ' leave the start comment mark for verify in readtag, <!--
                    ' to avoid change structure
                    ' clear the end comment mark
                Else
                    i += tagleadinglen
                    If Not findnext(content, i, len, AddressOf isnotspacechars) Then
                        i = len
                    End If
                    index = i
                    If Not findnext(content, i, len, AddressOf istagfinal) Then
                        i = len
                    End If
                    rtn = strmid(content, index, i - index)
                    kickRightBlank(rtn)
                    index = i + tagfinallen
                    ' return
                    ' tag attribute0=value0 attribute1=value1 ...
                End If
            Else
                t = type.text
                index = i
                If Not findnext(content, i, len, AddressOf istagleading) Then
                    i = len
                End If
                rtn = strmid(content, index, i - index)
                kickRightBlank(rtn)
                index = i
                ' return all text between last element to next element
                ' next element can be a </sometag> or <sometag ...>
            End If
        End If

        Return rtn
    End Function

    Public Function parse(ByVal content As String, ByRef root As xmlcontrol) As Boolean
        If (isemptystring(content)) Then
            Return False
        Else
            If root Is Nothing Then
                root = New container(output)
            Else
                root.clear()
            End If
            Dim index As Int32 = 0
            Dim len As Int32 = strlen(content)
            Dim t As type
            Dim cur As xmlcontrol = Nothing
            cur = root
            While index < len
                Dim rst As String
                rst = read(content, index, t, len)
                If Not rst Is Nothing Then
                    If t = type.tag Then
                        Dim ctrl As xmlcontrol = Nothing
                        Dim endtag As Boolean = False
                        ctrl = readtag(rst, endtag)
                        assert(Not ctrl Is Nothing OrElse endtag, "ctrl is nothing cannot be together with not endtag.")
                        If Not ctrl Is Nothing Then
                            cur.addchild(ctrl)
                            If Not endtag Then
                                cur = ctrl
                            End If
                        Else
                            If Not cur.father() Is Nothing Then
                                cur = cur.father()
                            Else
                                raiseError("will goto an empty node, avoid crash.", errorHandle.errorType.warning)
                            End If
                        End If
                    ElseIf t = type.text Then
                        If Not isemptystring(rst) Then
                            If isemptystring(Convert.ToString(cur.text)) Then
                                cur.text = rst
                            Else
                                cur.text += newline.incode() + rst
                            End If
                        End If
                    Else
                        assert(False, "should cover all possibilities.")
                    End If
                Else
                    assert(index = len, "should not return nothing when not end of input.")
                    Exit While
                End If
            End While

            Return True
        End If
    End Function

    Public Shared Sub unittest()
        Console.WriteLine("input a file to parse")
        Dim content As String
        content = System.IO.File.ReadAllText(Console.ReadLine())
        Dim root As xmlcontrol = Nothing
        Dim parser As parser = Nothing
        parser = New parser()
        parser.parse(content, root)
        Console.WriteLine(root.ToString())
    End Sub

    Public Sub New()
        output = Nothing
    End Sub

    Public Sub New(ByVal output As MemoryStream)
        Me.output = output
    End Sub
End Class

Public Class xmlparserPoolDefinition
    Inherits pool(Of parser, _true, _true)

    Protected Overrides Function create() As parser
        Return New parser()
    End Function

    Public Sub New()
        MyBase.New()
    End Sub

    Public Sub New(ByVal buffcount As Int64)
        MyBase.New(buffcount)
    End Sub
End Class
